{-# OPTIONS -fno-warn-name-shadowing -fno-warn-missing-signatures #-}
{- |
Module      :  Loader.ModelFlux
Description :  <optional short text displayed on contents page>
Copyright   :  (c) Sergey Sichevskiy 2012
License     :  BSD3

Maintainer  :  s.sichevskij@gmal.com
Stability   :  experimental
Portability :  portable


-}

module Loader.ModelFlux
 ( parseModelFlux
 )
   where

import Model
import Types        hiding ( Pickles, Castelli )
import Segregate           ( segregate )

import Data.HList          ( (:::)(..), Null(..) )
import Data.VectorSpace    ( (*^) )

import Loader.Parser
import Control.Applicative ( (<$>) )
import Control.Monad       ( forM  )
import Control.Monad.Error ( MonadIO, liftIO )


import qualified Types         as T
import qualified Interpolation as I

data ModelFluxType = Pickles | Castelli deriving (Read, Show)

--parseModelFlux :: (MonadError SCPError m, MonadIO m) => ModelFluxType -> Integrator -> m ModelFlux
  
parseModelFlux Pickles   x =  picklesParser  x
parseModelFlux Castelli  x = castelliParser  x

-- |Парсер для анализа данных о  Pickles.
picklesParser i = do
  liftIO $ putStrLn "\nParsing the Pickles Spectral Lib section...\n"

  f  <- get "PICKLES_SPECTRAL_ENERGY_DISTRIBUTION" "filter"  >>= parseBFuncFile
  v  <- get "PICKLES_SPECTRAL_ENERGY_DISTRIBUTION" "vega"    >>= parseBFuncFile

  ci   <- get "PICKLES_SPECTRAL_ENERGY_DISTRIBUTION" "class_i"   >>= parseSpectralSet f v
  ciii <- get "PICKLES_SPECTRAL_ENERGY_DISTRIBUTION" "class_iii" >>= parseSpectralSet f v
  cv   <- get "PICKLES_SPECTRAL_ENERGY_DISTRIBUTION" "class_v"   >>= parseSpectralSet f v

  return $ T.Pickles { classI = ci, classV = cv, classIII = ciii }

  where
    parseSpectralSet f v fn = do

       ((l,r,h), xs) <- parsePicklesSpectralSetFile fn

       t <- forM xs $ \(x,m,fn) -> do

          liftIO $ putStrLn $ "parse " ++ fn ++ "..."

          s <- parseBFuncFile fn

          let a = quad i $ f * v
              b = quad i $ f * s
              k = 100 * (10**(-0.4*m)) * a / b

          return (x, k *^ s)

       let m x = l + (r-l) * (exp $ -(x*x))

           f = I.linearSampling (l,r) h t

       return (f, m)

-- |Парсер для анализа данных о Castelli
{--
castelliParser _ = do
  liftIO $ putStrLn "\nParsing the Castelli Spectral Lib section...\n"

  f <- get "CASTELLI_SPECTRAL_ENERGY_DISTRIBUTION" "file" >>= parseSpectralSet

  return $ T.Castelli { flux = f }

  where
    parseSpectralSet fn = do

       liftIO $ putStrLn $ "parse " ++ fn ++ "..."

       ((l,r,h),xs) <- parseATLAS9Logg fn

       ts <- forM xs $ \(x,fn) -> do
                                   ((l,r,h),ys) <- parseATLAS9Teff fn

                                   zs <- forM ys $ \(y,fn) -> do
                                                                f <- parseATLAS9FluxFile fn
                                                                return (y,f)

                                   let m x = l + (r-l) * (exp $ -(x*x))

                                       f   = I.linearSampling (l,r) h zs

                                   return ((x,f), (x,m))

       let (fs,gs) = unzip ts
           f = I.linearSampling (l,r) h fs
           g = I.linearSampling (l,r) h gs

           m x = l + (r-l) * (exp $ -(x*x))

       return $ (f, \(x,y) -> (m x, g (m x) y))
--}
castelliParser _ = do
  liftIO $ putStrLn "\nParsing the Castelli Spectral Lib section...\n"

  (f,d) <- get "CASTELLI_SPECTRAL_ENERGY_DISTRIBUTION" "file" >>= parseSpectralSet

  return $ T.Castelli { flux = f, domain = d }

  where
    parseSpectralSet fn = do

       liftIO $ putStrLn $ "parse " ++ fn ++ "..."

       ((l,r,h),xs) <- parseATLAS9Logg fn

       ts <- forM xs $ \(x,fn) -> do

          ((l,r,h),ys) <- parseATLAS9Teff fn

          zs <- forM ys $ \(y,fn) -> do

             f <- parseATLAS9FluxFile fn
             return (y,f)
                                   
          let f = I.linearSampling (l,r) h zs

          return ( (x,f), ( Logg x, Teff . fst <$> ys) )

       let (fs,ds) = unzip ts

           f = I.linearSampling (l,r) h fs

           d =  concatMap (\(logg, teff) -> (\t-> t ::: logg ::: Null) <$> teff) <$> (segregate ds)
          
       return $ (\(Teff x ::: Logg y ::: Null) -> f y x, d)